home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok46 / programme / objektdemo.mod < prev    next >
Text File  |  1993-11-04  |  6KB  |  232 lines
  1. (*
  2.  * -------------------------------------------------------------------------
  3.  *
  4.  *    :Program.    ObjektDemo
  5.  *    :Contents.    Demonstration der IntuitionObjekte
  6.  *    :Author.    Reiner Nix
  7.  *    :Address.    Geranienhof 2, 5000 Köln 71 Seeberg
  8.  *    :Copyright.    Public Domain
  9.  *    :Language.    Modula-2
  10.  *    :Translator.    M2Amiga A-L V3.3d
  11.  *    :History.    V1.0    21.11.90
  12.  *    :Imports.    IntuitionTools        siehe diese Diskette
  13.  *    :Imports.    Amigagraphik        siehe diese Diskette
  14.  *    :Imports.    IntuitionObjekte    siehe diese Diskette
  15.  *
  16.  * -------------------------------------------------------------------------
  17.  *)
  18. MODULE ObjektDemo;
  19.  
  20. FROM    SYSTEM            IMPORT    ADR;
  21. FROM    Arts            IMPORT    Assert, TermProcedure;
  22. FROM    Exec            IMPORT    WaitPort, GetMsg, ReplyMsg;
  23. FROM    Intuition        IMPORT    NewWindow,
  24.                     IntuiMessage, IntuiMessagePtr,
  25.                     IDCMPFlags, IDCMPFlagSet,
  26.                     WindowFlags, WindowFlagSet,
  27.                     ScreenFlags, ScreenFlagSet,
  28.                     WindowPtr;
  29. FROM    IntuitionTools        IMPORT    initNewWindow;
  30. FROM    AmigaGraphik        IMPORT    OpenWindow, CloseWindow, UseWindow,
  31.                     NewWindowSize, Move,
  32.                     WriteString, WriteCard;
  33. FROM    IntuitionObjekte    IMPORT    ObjektEreignis, ObjektTyp,
  34.                     ObjektPtr,
  35.                     verarbeiteNachricht, aenderInfoSatz,
  36.                     frageHPosition, frageVPosition,
  37.                     setzeHPosition, setzeVPosition,
  38.                     frageObjektNr, findeObjekt,
  39.                     EingabeOk, erzeugeBooleanObjekt,
  40.                     erzeugeHPropObjekt, erzeugeVPropObjekt,
  41.                     erzeugeTextObjekt, erzeugeRealObjekt,
  42.                     verbindeObjekte, loescheAlleObjekte;
  43.  
  44.  
  45. CONST    keinFenster        ="AusgabeFenster ist nicht zu öffnen!";
  46.     Programmname        ="ObjektDemo";
  47.  
  48.     BoolWechselID        =1;
  49.     BoolMeldenID        =2;
  50.     BoolWiederholenID    =3;
  51.     HorizontalID        =4;
  52.     VertikalID        =5;
  53.     TextID            =6;
  54.     ZahlID            =7;
  55.  
  56.     maxX            =MAX (CARDINAL) DIV 70;
  57.     maxY            =MAX (CARDINAL) DIV 30;
  58.  
  59. VAR    Programmende    :BOOLEAN;
  60.     Fenster        :WindowPtr;
  61.     NachrichtPtr    :IntuiMessagePtr;
  62.     Nachricht    :IntuiMessage;
  63.  
  64.     Text        :ARRAY [0..51] OF CHAR;
  65.     Zahl        :REAL;
  66.     X, Y        :CARDINAL;
  67.  
  68.  
  69. PROCEDURE oeffneFenster        (VAR Fenster        :WindowPtr);
  70.  
  71. VAR    neuFenster    :NewWindow;
  72.  
  73. BEGIN
  74. initNewWindow (neuFenster,
  75.            0,12, 640,244,
  76.            0,1,
  77.            IDCMPFlagSet {closeWindow, newSize, sizeVerify},
  78.            WindowFlagSet {windowSizing, windowDrag, windowDepth,
  79.                           noCareRefresh, windowClose},
  80.            NIL,                (* firstGadget *)
  81.            NIL,                (* Checkmark *)
  82.            ADR (Programmname),
  83.            NIL,                (* Screen *)
  84.            NIL,                (* Bitmap *)
  85.            50, 25, -1,-1,
  86.            ScreenFlagSet {wbenchScreen});
  87. Fenster := OpenWindow (neuFenster);
  88. Assert (Fenster # NIL, ADR (keinFenster))
  89. END oeffneFenster;
  90.  
  91.  
  92. PROCEDURE schreibeAusgabe;
  93.  
  94. BEGIN
  95. UseWindow (Fenster);
  96. Move (20, 200); WriteString ("Horizontalwert  ="); WriteCard (X,5);
  97. Move (20, 210); WriteString ("Vertikalwert    ="); WriteCard (Y,5)
  98. END schreibeAusgabe;
  99.  
  100.  
  101. PROCEDURE WechselAktion        (    Ereignis        :ObjektEreignis;
  102.                      objekt        :ObjektPtr);
  103.  
  104. BEGIN
  105. IF Ereignis = An THEN
  106.   aenderInfoSatz (objekt,"     Aua!    ")
  107. ELSE
  108.   aenderInfoSatz (objekt," So ist gut. ")
  109.   END
  110. END WechselAktion;
  111.  
  112.  
  113. PROCEDURE MeldeAktion        (    Ereignis        :ObjektEreignis;
  114.                      objekt        :ObjektPtr);
  115.  
  116. BEGIN
  117. IF X <= MAX (CARDINAL)-500 THEN
  118.   INC (X, 500);
  119.   setzeHPosition (findeObjekt (Fenster, HorizontalID), X, maxX);
  120.   schreibeAusgabe
  121.   END
  122. END MeldeAktion;
  123.  
  124.  
  125. PROCEDURE WiederholungsAktion    (    Ereignis        :ObjektEreignis;
  126.                      objekt        :ObjektPtr);
  127.  
  128. BEGIN
  129. IF Y >= MIN (CARDINAL)+500 THEN
  130.   DEC (Y, 500);
  131.   setzeVPosition (findeObjekt (Fenster, VertikalID), Y, maxY);
  132.   schreibeAusgabe
  133.   END;
  134. END WiederholungsAktion;
  135.  
  136.  
  137. PROCEDURE PropAktion        (    Ereignis        :ObjektEreignis;
  138.                      objekt        :ObjektPtr);
  139.  
  140. BEGIN
  141. CASE frageObjektNr (objekt) OF
  142. | HorizontalID    :X := frageHPosition (objekt)
  143. | VertikalID    :Y := frageVPosition (objekt)
  144. ELSE
  145.   END;
  146. schreibeAusgabe
  147. END PropAktion;
  148.  
  149.  
  150. PROCEDURE pruefeZahl        (    objekt        :ObjektPtr) :BOOLEAN;
  151.  
  152. BEGIN
  153. UseWindow (Fenster);
  154. Move (20, 225);
  155. IF (7.0 < Zahl) AND (Zahl < 7.77E2) THEN
  156.   WriteString ("                                                 ");
  157.   RETURN TRUE
  158. ELSE
  159.   WriteString ("Bitte geben Sie eine Zahl zwischen 7 und 777 ein.");
  160.   RETURN FALSE
  161.   END
  162. END pruefeZahl;
  163.  
  164.  
  165. PROCEDURE erstelleObjekte;
  166.  
  167. BEGIN
  168. Text := "Hallo";
  169. Zahl := 3.1415926;
  170. X := 0;
  171. Y := 20000;
  172. erzeugeBooleanObjekt (Fenster, 100, 50, " Drück mich  ", BoolWechselID,
  173.                       wechseln, WechselAktion);
  174. erzeugeBooleanObjekt (Fenster, 100, 70, " Melden      ", BoolMeldenID,
  175.                       melden, MeldeAktion);
  176. erzeugeBooleanObjekt (Fenster, 100, 90, " Wiederholen ", BoolWiederholenID,
  177.                       wiederholen, WiederholungsAktion);
  178.  
  179. erzeugeHPropObjekt (Fenster, 100,100, 104,8, X,maxX, HorizontalID, wiederholen,
  180.             PropAktion);
  181. erzeugeVPropObjekt (Fenster, 80, 50, 16,50, Y,maxY, VertikalID, wiederholen,
  182.             PropAktion);
  183.  
  184. erzeugeTextObjekt (Fenster, 400, 50, "Textobjekt :", TextID, -150,0,
  185.                    20, 50, EingabeOk, Text);
  186. erzeugeRealObjekt (Fenster, 400, 70, "Zahlobjekt :", ZahlID, -150,0,
  187.                    12,2, TRUE, pruefeZahl, Zahl);
  188. verbindeObjekte (Fenster, TextID, -1, ZahlID, -1, -1);
  189. verbindeObjekte (Fenster, ZahlID, TextID, -1, -1, -1)
  190. END erstelleObjekte;
  191.  
  192.  
  193. PROCEDURE stopObjektDemo;
  194.  
  195. BEGIN
  196. loescheAlleObjekte (Fenster);
  197. CloseWindow (Fenster)
  198. END stopObjektDemo;
  199.  
  200.  
  201. (* MODULE ObjektDemo *)
  202. BEGIN
  203. Fenster := NIL;
  204. TermProcedure (stopObjektDemo);
  205.  
  206. Programmende := FALSE;
  207. oeffneFenster (Fenster);
  208. erstelleObjekte;
  209.  
  210. WHILE NOT Programmende DO
  211.   WaitPort (Fenster^.userPort);
  212.     REPEAT
  213.     NachrichtPtr := GetMsg (Fenster^.userPort);
  214.     IF NachrichtPtr # NIL THEN
  215.       Nachricht := NachrichtPtr^;
  216.       ReplyMsg (NachrichtPtr);
  217.       verarbeiteNachricht (Fenster, Nachricht);
  218.       IF    closeWindow IN Nachricht.class THEN
  219.         Programmende := TRUE
  220.       ELSIF newSize IN Nachricht.class THEN
  221.         NewWindowSize;
  222.         schreibeAusgabe;
  223.       ELSIF sizeVerify IN Nachricht.class THEN
  224.         (* keine Aktion, Intuition wartet bis die Nachricht zurückgegeben ist *)
  225.         (* ändert erst dann die Fenstergröße und gibt die Nachricht newSize,  *)
  226.         (* so bleiben während einer Programmausgabe die Fenstermaße konstant. *)
  227.         END
  228.       END
  229.     UNTIL (NachrichtPtr = NIL) OR Programmende
  230.   END
  231. END ObjektDemo.
  232.